home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1997 April / EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso / EARCD / gfx / show / visagecom.lha / VisageCom.e < prev    next >
Text File  |  1996-11-30  |  22KB  |  587 lines
  1. /*************************************************************************
  2. *                                                                        *
  3. *                              VisageCom                                 *
  4. *                                                                        *
  5. *  By Philippe "Elwood" FERRUCCI                         Decines FRANCE  *
  6. *                                                                        *
  7. *************************************************************************/
  8.  
  9. MODULE 'dos/dos','intuition/screens','intuition/intuition',
  10.        'gadtools','libraries/gadtools','reqtools','libraries/reqtools',
  11.        'utility/tagitem','graphics/gfxbase',
  12.        'graphics/rastport','graphics/text','exec/ports','exec/nodes',
  13.        'dos/dosextens','exec/tasks',
  14.  
  15.        'intuition/intuitionbase',       
  16.  
  17.        'exec/io',            -> iostdreq
  18.        'devices/input',      -> CMD_WAITEVENT
  19.        'devices/inputevent', -> inputevent
  20.        'exec/memory'         -> MEMF_PUBLIC
  21.  
  22. ENUM NONE,NOARGS,NOMEM,NOLIB,NOGAD,NOFILE1,NOFILE2
  23.  
  24. DEF progname[50]:STRING,args:PTR TO LONG,template,rdargs
  25.  
  26. -> filename can be 108 chars long
  27. DEF filename[108]:STRING,destination[108]:STRING,validdest
  28. DEF p_filelock=NIL,fib=NIL:PTR TO fileinfoblock
  29.  
  30. DEF topscreen=200 -> horizontal line where the visagecom screen will open
  31. DEF scr=NIL:PTR TO screen,win=NIL:PTR TO window,wintitle[100]:STRING
  32.  
  33. DEF screen=NIL:PTR TO screen        -> screen used only when using 'Set Dir'
  34. DEF visual,glist=NIL,p_gad:PTR TO gadget
  35. DEF idcmp
  36.  
  37. DEF getout=0,useranswer,p_task:PTR TO task   -> to find the visage task
  38.  
  39. OBJECT button      -> used to create a list of button
  40.   item:PTR TO CHAR
  41. ENDOBJECT
  42.  
  43. RAISE NOARGS  IF ReadArgs() = NIL,            -> automatic error handling :
  44.       NOLIB   IF OpenLibrary() = NIL,         -> when the program is done
  45.       NOMEM   IF OpenScreenTagList() = NIL,   -> I sequentially pick each
  46.       NOGAD   IF GetVisualInfoA() = NIL,      -> potential failure of the
  47.       NOGAD   IF CreateContext() = NIL,       -> program and I build this
  48.       NOGAD   IF CreateGadgetA() = NIL,       -> list.
  49.       NOMEM   IF OpenWindowTagList() = NIL,   -> Thanks to Wouter, the
  50.       NOFILE1 IF Read() = -1,                 -> source is easier to read
  51.       NOMEM   IF New() = NIL,                 -> and understand.
  52.       NOFILE2 IF AddPart() = NIL,
  53.       NOMEM   IF RtAllocRequestA() = NIL
  54.  
  55. PROC main() HANDLE
  56.   VOID '$VER: VisageCom 1.22 By Philippe "Elwood" FERRUCCI (28/11/96)'
  57.  
  58.   init()
  59.  
  60.   examinefile(filename)
  61.  
  62.   opengui()
  63.  
  64.   mainloop()
  65.  
  66.   Raise(NONE)    -> everything is done we get out of here.
  67.  
  68. EXCEPT
  69.   -> if pointer is still valid then "remove it"
  70.   IF p_filelock THEN UnLock(p_filelock)
  71.   IF fib THEN FreeDosObject(DOS_FIB,fib)
  72.  
  73.   IF scr THEN ScreenToBack(scr)
  74.   IF win THEN CloseWindow(win); win := NIL  -> close the window first !
  75.   IF glist THEN FreeGadgets(glist)          -> and this line second.
  76.   IF visual THEN FreeVisualInfo(visual)
  77.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  78.   IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  79.  
  80.   IF scr    THEN CloseScreen(scr);    scr    := NIL -> those NIL are not
  81.   IF screen THEN CloseScreen(screen); screen := NIL -> usefull
  82.  
  83.   -> I close everything before saying Visage to continue to avoid problems
  84.   -> I encoutered in double buffering mode
  85.   -> (the new selected window wasn't the "in front" one)
  86.  
  87.   -> when Visage is showing an image it (Visage itself or the datatype it
  88.   -> is using) locks that file, so before deleting
  89.   -> I have to say to Visage to continue in order to remove the lock
  90.  
  91.   IF (getout >= 1) AND (getout <= 5) THEN
  92.      IF (p_task := getvisagetask()) THEN Signal(p_task,SIGBREAKF_CTRL_D)
  93.  
  94.   IF (getout = 2) OR (getout = 3)
  95.      Delay(50)             -> I wait a while to be sure lock is dead
  96.      DeleteFile(filename)  -> guess what this dos library function do ?
  97.   ENDIF
  98.  
  99.   SELECT exception
  100.     CASE NOARGS
  101.       WriteF('Usage: \s <filename> <destination>\n',progname)
  102.     CASE NOMEM
  103.       WriteF('Not enough memory !\n')
  104.     CASE NOLIB
  105.       WriteF('Can''t open required libraries !\n')
  106.     CASE NOGAD
  107.       WriteF('Failure in a gadtools function !\n')
  108.     CASE NOFILE1
  109.       WriteF('Can''t read file correctly !\n')
  110.     CASE NOFILE2
  111.       WriteF('Can''t write file !\n')
  112.   ENDSELECT
  113.   CleanUp(0)    -> Amiga E cleans used RAM
  114.  
  115. ENDPROC
  116.  
  117. PROC examinefile(name:PTR TO CHAR)
  118. DEF tmp
  119.  
  120.   IF (p_filelock := Lock(name,ACCESS_READ)) = 0 THEN Raise(NOFILE1)
  121.  
  122.   IF (fib := AllocDosObject(DOS_FIB,NIL))
  123.      tmp := Examine(p_filelock,fib) 
  124.      IF tmp = 0       -> fills 'fib' structure
  125.         FreeDosObject(DOS_FIB,fib)        -> with infos about the file
  126.         fib := NIL
  127.      ENDIF
  128.   ENDIF
  129.  
  130. ENDPROC
  131.  
  132. PROC opengui()
  133.  
  134.   scr := OpenScreenTagList(NIL,[SA_TOP,topscreen,     -> open screen at
  135.                                 SA_HEIGHT,50,         -> bottom of display
  136.                                 SA_LIKEWORKBENCH,TRUE,
  137.                                 SA_TYPE,PUBLICSCREEN,
  138.                                 SA_PUBNAME,'VisageCom',
  139.                                 SA_DRAGGABLE,FALSE,
  140.   -> opened and prepared behind for aesthetic reasons
  141.                                 SA_BEHIND,TRUE,
  142.                                 SA_QUIET,TRUE,    -> useless but who cares
  143.                                 TAG_DONE])            -> end of tag list
  144.  
  145.   visual := GetVisualInfoA(scr,NIL) -> initialises some gadtools structures
  146.  
  147.   p_gad := CreateContext({glist})   -> creates the shadow gadget used as
  148.                                     -> the first gadget of the window
  149.  
  150.   -> the same thing is done 6 times (each gadget) so it would be too long
  151.   -> and unreadable here. That's why a used a PROC routine.
  152.   p_gad:=preparegadget(p_gad,['_Copy','_Delete','_Move','_Rename',
  153.                               'C_omment','_Set Dir','C_ancel']:button)
  154.  
  155.   -> the window title will be like this: "Choose an action for <filename>"
  156.   StrCopy(wintitle,'Image: ',ALL)
  157.   StrAdd(wintitle,filename,ALL)
  158.   StrAdd(wintitle,'   Destination: ',ALL)
  159.   StrAdd(wintitle,destination,ALL)
  160.  
  161.   win := OpenWindowTagList(NIL,[WA_TOP,0,     -> open a window on the
  162.                                 WA_LEFT,0,    -> previous opened screen
  163.                                 WA_WIDTH,640,
  164.                                 WA_PUBSCREEN,scr,  -> pointer to the screen
  165.                                 WA_GADGETS,glist,  -> gadget list prepared
  166.                                 WA_ACTIVATE,    TRUE,
  167.   -> I want to be warned by the great Amiga IDCMP system when those
  168.   -> events occured: key/mousebutton pressed or window is made inactive or
  169.   -> a gadget has been used
  170.                                 WA_IDCMP, IDCMP_VANILLAKEY OR
  171.                                           IDCMP_MOUSEBUTTONS OR
  172.                                           IDCMP_INACTIVEWINDOW OR
  173.                                           IDCMP_INTUITICKS OR
  174.                                           IDCMP_GADGETUP,
  175.                                 WA_TITLE,       wintitle,
  176.                                 TAG_DONE])
  177.  
  178.   Gt_RefreshWindow(win,NIL)   -> needed by gadtools after window is opened
  179.  
  180.   IF validdest = FALSE THEN disablegad(win,[1,3])
  181.  
  182.   ScreenToFront(scr)          -> the screen is ready to be introduced to you
  183.  
  184.   setmouse(scr,p_gad.leftedge,p_gad.topedge) -> mouse goes to last gadget
  185.  
  186. ENDPROC
  187.  
  188. PROC mainloop()
  189.   DEF int:PTR TO intuitionbase
  190.  
  191.   -> !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  192.   -> Please pay attention that if you use gadtools features you have to
  193.   -> use gadtools version of message managing: GT_GetIMsg and GT_ReplyIMsg
  194.   -> instead of the intuition equivalent (GetMsg and ReplyMsg) included in
  195.   -> in the E procedure WaitIMessage (have a look at this one in the E doc)
  196.   -> used here (I know I'm a bad boy ! )
  197.  
  198.   WHILE getout = 0
  199.  
  200.     idcmp := WaitIMessage(win)        -> we wait one of the wanted IDCMP
  201.  
  202.     SELECT idcmp
  203.  
  204.       CASE IDCMP_INTUITICKS
  205.          int := intuitionbase
  206.          screen := int.firstscreen.nextscreen  -> must be the Visage screen
  207.          IF StrCmp(screen.title,'Visage') = FALSE THEN getout := -1
  208.  
  209.       CASE IDCMP_GADGETUP             -> a gadget has been pressed/released
  210.          p_gad := MsgIaddr()          -> which one ?
  211.          getout := p_gad.gadgetid     -> 'getout' is set with the gadget id
  212.  
  213.       CASE IDCMP_MOUSEBUTTONS         -> button pressed
  214.          -> left mouse button pressed outside the window
  215.          IF (MsgCode() = SELECTUP) AND (scr.mousey < 0) THEN getout := -1
  216.  
  217.       CASE IDCMP_INACTIVEWINDOW
  218.          ActivateWindow(win)   -> makes the window be the active one again
  219.  
  220.       CASE IDCMP_VANILLAKEY       -> a key pressed
  221.          useranswer := MsgCode()  -> which one ?
  222.          SELECT useranswer
  223.            CASE "c"               -> Copy
  224.              getout:=1
  225.            CASE "d"               -> Delete
  226.              getout:=2
  227.            CASE "m"               -> Move
  228.              getout:=3
  229.            CASE "r"               -> Rename
  230.              getout:=4
  231.            CASE "o"               -> Comment
  232.              getout:=5
  233.            CASE "s"               -> Set dir
  234.              getout:=6
  235.            CASE "a"               -> Cancel
  236.              getout:=7
  237.          ENDSELECT
  238.  
  239.     ENDSELECT
  240.  
  241.     -> Action !!!
  242.     SELECT getout            -> gadget selected / key pressed
  243.  
  244.     -> please pay attention that all delete actions are made later
  245.     -> see below for explanation
  246.  
  247.       CASE 1
  248.          copyfile(filename)  -> we copy the file to destination
  249.       CASE 3
  250.          copyfile(filename)  -> the same. (delete is done after)
  251.       CASE 4
  252.          IF (dorename(filename)) = 0 THEN getout := 0  -> rename cancelled
  253.       CASE 5
  254.          IF (docomment(filename)) = 0 THEN getout := 0 -> comment cancelled
  255.       CASE 6
  256.          setdir()      -> we change destination
  257.          StrCopy(wintitle,'Image: ',ALL)
  258.          StrAdd(wintitle,filename,ALL)
  259.          StrAdd(wintitle,'   Destination: ',ALL)
  260.          StrAdd(wintitle,destination,ALL)
  261.          SetWindowTitles(win,wintitle,-1)  -> updates the window title
  262.          getout := 0   -> we continue
  263.     ENDSELECT
  264.  
  265.   ENDWHILE
  266.  
  267. ENDPROC
  268.  
  269. PROC init()
  270. DEF tmplock
  271.  
  272.   -> this is only for writing a good 'Usage' message (if you changed the
  273.   -> name of the prog (in 'Vcom' for instance)
  274.   IF (GetProgramName(progname,50)) = 1 THEN StrCopy(progname,'VisageCom',ALL)
  275.  
  276.   args:=[NIL,NIL,NIL]                          -> init args structure.
  277.   template:='FILE/A,DEST/A,TOPSCREEN/N'        -> 2 arguments needed.
  278.   rdargs:=ReadArgs(template,args,NIL)          -> dos library function.
  279.  
  280.   StrCopy(filename,args[],ALL)                 -> copy of args in Estring
  281.   StrCopy(destination,args[1],ALL)             -> fields.
  282.   IF args[2]
  283.      topscreen := args[2]
  284.      topscreen := ^topscreen
  285.   ENDIF
  286.   FreeArgs(rdargs)                             -> dos library function.
  287.  
  288.   -> we check if destination is valid
  289.   IF (tmplock := Lock(destination,ACCESS_READ)) = 0
  290.      validdest := FALSE
  291.      StrCopy(destination,'<Invalid>',ALL)
  292.   ELSE
  293.      UnLock(tmplock)
  294.      validdest := TRUE
  295.   ENDIF
  296.  
  297.   gadtoolsbase := OpenLibrary('gadtools.library',39)  -> open needed libs
  298.   reqtoolsbase := OpenLibrary('reqtools.library',38)
  299.  
  300. ENDPROC
  301.  
  302. PROC preparegadget(gad:PTR TO gadget,buttonlist:PTR TO button)
  303. DEF saveptr,id,len,text[100]:STRING
  304.  -> next line used to get the default font
  305. DEF p_ta:PTR TO textattr,gfx:PTR TO gfxbase,p_tf:PTR TO textfont,node:PTR TO node
  306. DEF intuilen,intui:PTR TO intuitext
  307. DEF leftedge,between
  308.  
  309.   -> fasten your seat belt and here we go
  310.   -> I hope this is the good way to do it
  311.  
  312.   len := ListLen(buttonlist)   -> how much gadget we have to create
  313.  
  314.   -> we look for the default font
  315.   gfx := gfxbase           -> we get a pointer to the gfxbase structure
  316.   p_tf := gfx.defaultfont  -> in gfxbase we get a pointer to a textfont struct
  317.   node := p_tf.message.node   -> and another pointer to get the fontname
  318.   p_ta := [node.name,p_tf.ysize,p_tf.style,p_tf.flags]:textattr
  319.  
  320.   saveptr := buttonlist
  321.  
  322.   -> here I count how much pixels must be placed between each gadget
  323.   FOR id := 1 TO len           -> BAD:   FOR ind := 1 TO ListLen(buttonlist)
  324.     StrAdd(text,^buttonlist)   -> we create a string with all texts
  325.     buttonlist++               -> we get the next one
  326.   ENDFOR
  327.   intui := [1,0,RP_JAM1,0,0,p_ta,text,NIL]:intuitext
  328.   intuilen := IntuiTextLength(intui)        -> length of characters
  329.   between := (640 - intuilen) / (len + 1)   -> step between each gadget
  330.   leftedge := -10                           -> a small correction
  331.   intuilen := 0
  332.  
  333.   buttonlist := saveptr
  334.   FOR id := 1 TO len           -> BAD:   FOR ind := 1 TO ListLen(buttonlist)
  335.     StrCopy(text,^buttonlist,ALL)   -> we get the text of the current object
  336.     buttonlist++                    -> we get the next one for next run
  337.  
  338.     -> this, is to create each gadget at 'between' pixels from the previous
  339.     leftedge := leftedge + intuilen + between
  340.  
  341.     -> length of current gadget text
  342.     intui := [1,0,RP_JAM1,0,0,p_ta,text,NIL]:intuitext
  343.     intuilen := IntuiTextLength(intui)
  344.  
  345.     IF ((id = 1) OR (id = 3)) AND (validdest = FALSE)  -> Copy/Move disabled
  346.        gad := CreateGadgetA(
  347.                BUTTON_KIND,gad,              -> type,previous gadget
  348.                [leftedge,20,intuilen+15,20,  -> leftedge,topedge,width,height
  349.                  text,p_ta,                  -> gadgettext,font
  350.                  id,PLACETEXT_IN,            -> ID,position
  351.                  visual,0]:newgadget,        -> visual,userdata
  352.                [GT_UNDERSCORE,"_",
  353.                 GFLG_DISABLED,TRUE,TAG_END])   -> additional taglist
  354.     ELSE
  355.        gad := CreateGadgetA(
  356.                BUTTON_KIND,gad,              -> type,previous gadget
  357.                [leftedge,20,intuilen+15,20,  -> leftedge,topedge,width,height
  358.                  text,p_ta,                  -> gadgettext,font
  359.                  id,PLACETEXT_IN,            -> ID,position
  360.                  visual,0]:newgadget,        -> visual,userdata
  361.                [GT_UNDERSCORE,"_",TAG_END])  -> additional taglist
  362.     ENDIF
  363.   ENDFOR
  364. ENDPROC gad
  365.  
  366. -> enables gadgets of a specific window
  367. PROC enablegad(p_win:PTR TO window,idlist:PTR TO LONG)
  368.   DEF len,i,gadid,p_gad:PTR TO gadget
  369.  
  370.   -> instead of saving the gadget address of the 2 gadgets I wanted to
  371.   -> enable/disable, I wrote this PROC which allows you to enable the
  372.   -> first and the third gadget of a specific window calling:
  373.   -> enablegad(win,[1,3])
  374.  
  375.   len := ListLen(idlist)
  376.   p_gad := p_win.firstgadget   -> we get the address of the first gadget
  377.  
  378.   FOR i := 1 TO len            -> for each number of gadget, we lokk for it
  379.     gadid := ^idlist; idlist++          -> in the gadget list
  380.     WHILE p_gad.gadgetid <> gadid       -> of the window
  381.       p_gad := p_gad.nextgadget         -> and we enable the one
  382.     ENDWHILE                            -> we want: the first one and the
  383.     OnGadget(p_gad,p_win,NIL)           -> third one here.
  384.   ENDFOR
  385.  
  386. ENDPROC
  387.  
  388. PROC disablegad(p_win:PTR TO window,idlist:PTR TO LONG)
  389.   DEF len,i,gadid,p_gad:PTR TO gadget
  390.  
  391.   len := ListLen(idlist)
  392.   p_gad := p_win.firstgadget
  393.  
  394.   FOR i := 1 TO len
  395.     gadid := ^idlist; idlist++
  396.     WHILE p_gad.gadgetid <> gadid
  397.       p_gad := p_gad.nextgadget
  398.     ENDWHILE
  399.     OffGadget(p_gad,p_win,NIL)
  400.   ENDFOR
  401.  
  402. ENDPROC
  403.  
  404. PROC copyfile(file)
  405. DEF filelen,filehandler,basename:PTR TO CHAR
  406. DEF mem=NIL
  407.  
  408.   filelen := FileLength(file)
  409.  
  410.   -> file is already locked
  411.  
  412.   IF (filehandler := Open(file,OLDFILE)) = NIL THEN Raise(NOFILE1)
  413.  
  414.   mem := New(filelen)               -> we allocate memory to store the file
  415.   Read(filehandler,mem,filelen)     -> we store the file in memory
  416.   Close(filehandler)                -> close the file
  417.  
  418.   basename := FilePart(file)           -> extract the filename
  419.   AddPart(destination,basename,100)    -> add this name to destination dir
  420.  
  421.   IF (filehandler := Open(destination,NEWFILE)) = NIL THEN Raise(NOFILE2)
  422.   IF Write(filehandler,mem,filelen) = -1  -> error (e.g. no free space)
  423.      Close(filehandler)
  424.      DeleteFile(destination)
  425.   ELSE
  426.      Close(filehandler)
  427.      -> copy date and filecomment found in 'fib'
  428.      IF fib
  429.         SetFileDate(destination,fib.datestamp)
  430.         SetComment(destination,fib.comment)
  431.         FreeDosObject(DOS_FIB,fib); fib := NIL
  432.      ENDIF
  433.   ENDIF
  434.  
  435. ENDPROC
  436.  
  437. PROC dorename(file)
  438. DEF answer[108]:STRING,wintitle[130]:STRING,req
  439.  
  440.   StrCopy(wintitle,'Enter new name for ',ALL)
  441.   StrAdd(wintitle,file,ALL)
  442.  
  443.   StrCopy(answer,file,ALL)
  444.   req := RtAllocRequestA(RT_REQINFO,NIL)     -> allocate what is needed (!)
  445.   useranswer := RtGetStringA(answer,200,wintitle,req,
  446.                              [RT_WINDOW,win,
  447.                               RT_IDCMPFLAGS,IDCMP_INACTIVEWINDOW,
  448.                               RTGS_WIDTH,640,
  449.                               RT_TOPOFFSET,0,
  450.                               TAG_DONE])     -> taglists should end like this
  451.   RtFreeRequest(req)                         -> free what was allocated
  452.  
  453.   -> if user closed the requester with return/OK then rename file
  454.   IF useranswer
  455.      -> if you inactive the requester, useranswer will be the IDCMP
  456.      IF useranswer = IDCMP_INACTIVEWINDOW
  457.         useranswer := 0
  458.      ELSE
  459.         Rename(file,answer)
  460.      ENDIF
  461.   ENDIF
  462.  
  463. ENDPROC useranswer     -> used to know if rename has been done or canceled
  464.  
  465. PROC docomment(file)
  466. DEF req,answer[108]:STRING,wintitle[130]:STRING
  467.  
  468.   StrCopy(wintitle,'Enter comment for ',ALL)
  469.   StrAdd(wintitle,file,ALL)
  470.  
  471.   IF fib THEN StrCopy(answer,fib.comment,ALL)
  472.   req := RtAllocRequestA(RT_REQINFO,NIL)     -> allocate what is needed (!)
  473.   useranswer := RtGetStringA(answer,200,wintitle,req,
  474.                              [RT_WINDOW,win,
  475.                               RT_IDCMPFLAGS,IDCMP_INACTIVEWINDOW,
  476.                               RTGS_WIDTH,640,
  477.                               RT_TOPOFFSET,0,
  478.                               TAG_DONE])     -> taglists should end like this
  479.   RtFreeRequest(req)                         -> free what was allocated
  480.  
  481.   -> if user closed the requester with return/OK then save comment
  482.   IF useranswer
  483.      IF useranswer = IDCMP_INACTIVEWINDOW
  484.         useranswer := 0
  485.      ELSE
  486.         SetComment(file,answer)
  487.      ENDIF
  488.   ENDIF
  489.  
  490. ENDPROC useranswer     -> used to know if setcomment has been done
  491.  
  492. PROC setdir()
  493. DEF req:PTR TO rtfilerequester,answer[108]:ARRAY
  494.  
  495.   req := RtAllocRequestA(RT_FILEREQ,NIL)
  496.  
  497.   -> as my screen was too small for the requester, here is a second one
  498.   screen := OpenScreenTagList(NIL,[SA_LIKEWORKBENCH,TRUE,
  499.                                    SA_TITLE,'Set Dir',
  500.                                    SA_DRAGGABLE,FALSE,
  501.                                    TAG_DONE])
  502.   IF validdest THEN RtChangeReqAttrA(req,[RTFI_DIR,destination])
  503.   useranswer := RtFileRequestA(req,
  504.                                answer,'Choose a new destination',
  505.                                [RT_SCREEN,screen,
  506.                                 RT_REQPOS,REQPOS_CENTERSCR,
  507.                                 RTFI_FLAGS,FREQF_NOFILES,
  508.                                 TAG_DONE])
  509.   IF useranswer
  510.      validdest := TRUE
  511.      StrCopy(destination,req.dir,ALL)
  512.      enablegad(win,[1,3])
  513.   ENDIF
  514.  
  515.   RtFreeRequest(req)
  516.   CloseScreen(screen)
  517.   screen := NIL        -> this NIL is important (when something fails) !
  518.  
  519. ENDPROC
  520.  
  521. PROC getvisagetask()
  522. DEF p_process:PTR TO process,p_cli:PTR TO commandlineinterface
  523. DEF clinum,lastclinum,taskname[80]:STRING,taskfound=FALSE
  524.  
  525.   clinum     := 1
  526.   lastclinum := MaxCli()                  -> get the last cli number
  527.  
  528.   -> browse each cli process from 1 to lastclinum - 1
  529.   WHILE (taskfound=FALSE) AND (clinum<lastclinum)
  530.     p_process := FindCliProc(clinum)      -> finds this process
  531.  
  532.             -> perhaps the task has been removed since the call to MaxCli()
  533.     IF p_process
  534.       p_task := p_process.task              -> pointer to the process task
  535.       p_cli := Shl(p_process.cli,2)         -> converts the BCPL address
  536.       taskname := Shl(p_cli.commandname,2)  -> commandname is a BCPL too
  537.       taskname := TrimStr(taskname)         -> needs a correct format
  538.       taskname := LowerStr(FilePart(taskname))
  539.       IF StrCmp(taskname,'visage',ALL) THEN taskfound := TRUE
  540.     ENDIF
  541.     INC clinum
  542.   ENDWHILE
  543.  
  544.   IF taskfound = FALSE THEN p_task := NIL
  545.  
  546. ENDPROC p_task
  547.  
  548. PROC setmouse(scr:PTR TO screen,x,y)
  549.   DEF p_iostdreq:PTR TO iostdreq,mp:PTR TO msgport,p_ievent:PTR TO inputevent
  550.   DEF ppix:PTR TO iepointerpixel
  551.  
  552.   -> code based upon SetMouse from Ketil Hunn
  553.  
  554.   IF (mp := CreateMsgPort())
  555.      IF (p_ievent := AllocVec(SIZEOF inputevent, MEMF_PUBLIC))
  556.         IF (ppix := AllocVec(SIZEOF iepointerpixel, MEMF_PUBLIC))
  557.            IF p_iostdreq := CreateIORequest(mp,SIZEOF iostdreq)
  558.               IF Not (OpenDevice('input.device', NIL, p_iostdreq, NIL))
  559.                  ppix.screen    := scr
  560.                  ppix.positionx := x
  561.                  ppix.positiony := y
  562.  
  563.                  p_ievent.nextevent    := NIL
  564.                  p_ievent.class        := IECLASS_NEWPOINTERPOS
  565.                  p_ievent.subclass     := IESUBCLASS_PIXEL
  566.                  p_ievent.code         := 0
  567.                  p_ievent.qualifier    := NIL
  568.                  p_ievent.eventaddress := ppix
  569.  
  570.                  p_iostdreq.data    := p_ievent
  571.                  p_iostdreq.length  := SIZEOF inputevent
  572.                  p_iostdreq.command := IND_WRITEEVENT
  573.                  DoIO(p_iostdreq)
  574.  
  575.                  CloseDevice(p_iostdreq)
  576.               ENDIF
  577.               DeleteIORequest(p_iostdreq)
  578.            ENDIF
  579.            FreeVec(ppix)
  580.         ENDIF
  581.         FreeVec(p_ievent)
  582.      ENDIF
  583.      DeleteMsgPort(mp)
  584.   ENDIF
  585.  
  586. ENDPROC
  587.